00100		TITLE SLOOP
00200		ENTRY RNOTE,DRWNT,RDRAW,SLOOP,CIRCLE,PSRT
00300		EXTERNAL PTR,XRN,STF,.COMM.,CLEFS,AMOD,LINES,ALF,SLR
00400		EXTERNAL EXP3.2,SIN,COS,ATAN2,PLTR,SIND,COSD
00500		DEFINE FIXX(N)
00600	<	JUMPGE	N,.+5
00700		MOVNS	N
00800		FIX 	N,233000    
00900		MOVNS	N
01000		CAIA
01100		FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
01200	
01300		RB←15↔RX←14↔RA←13↔R←12↔KK←11↔LL←10↔RW←7↔RZ←6↔SY←5
01400	SLOOP:	0
01500		MOVE	RB,.COMM.+=18	;RB=RX/71.
01600		FDVR	RB,[=71.0]
01700		SETZ	KK,	;DO 81 K=0,71
01800	SLR81:	MOVE	RA,KK
01900		TLC	RA,232000	; FLOAT RA
02000		FADR	RA,RA
02100		FMPR	RA,RB
02200		FADR	RA,.COMM.+4	;81	SLURX(K+1)=RB*(K)+R3
02300		MOVEI	1,SLR
02400		ADDI	1,(KK)
02500		MOVEM	RA,(1)
02600		CAIGE	KK,=71
02700		AOJA	KK,SLR81
02800		MOVE	RA,.COMM.+=8	;RA=R7*RST7
02900		FMPR	RA,.COMM.+=17
03000		SKIPN	RX,.COMM.+=10	;41	IF(R9.EQ.0)R9=RZZ
03100		MOVE	RX,[=2.8]	;RX IS R9
03200	SLR41:	MOVE	R,.COMM.+2	;R=R+RA    CENTR IS R
03300		FADR	R,RA
03400		SETZ	LL,		;L=0
03500		MOVE	KK,[=36.0]	;DO 40 K=36,1,-1
03600		MOVNS	RA
03700	SLR40:	AOJ	LL,		;L=L+1
03800		MOVE	2,KK		;RW=R-RA*(K/36.)**R9
03900		FDVR	2,[=36.0]
04000		MOVE	3,RX
04100		PUSHJ	17,EXP3.2	; I HOPE! AC2=AC2**AC3
04200		FMPR	2,RA
04300		MOVE	RW,2
04400		FADR	RW,R
04500		MOVEI	1,ALF	;	SLURY(L)=RW
04600		ADDI	1,(LL)
04700		MOVEM	RW,(1)		;ALF IS 1 BEFORE SLURY(1)
04800		MOVE	2,[=73]	;40	SLURY(73-L)=RW
04900		SUBI	2,(LL)
05000		MOVEI	1,ALF
05100		ADDI	1,(2)
05200		MOVEM	RW,(1)
05300		FSBR	KK,[=1.0]
05400		JUMPG	KK,SLR40
05500	
05600		MOVE	2,.COMM.+=20	;89	IF(RTILT.EQ.0)GO TO 87
05700		JUMPE	2,SLR87		;RETURNS
05800		JSA	16,ATAN2	;RW=ATAN2(RTILT,RXX)
05900		JUMP	.COMM.+=20
06000		JUMP	.COMM.+=19
06100		MOVE	RW,0
06200		JSA	16,SIN		;RA=SIN(RW)
06300		JUMP	RW		; ????
06400		MOVE	RA,0
06500		JSA	16,COS		;RB=COS(RW)
06600		JUMP	RW
06700		MOVE	RB,0
06800		MOVE	RZ,SLR		;RZ=SLURX(1)
06900		MOVE	RW,ALF+1		;RW=SLURY(1)
07000		MOVEI	KK,SLR		;DO 83 K=1,L
07100		MOVEI	4,=72
07200		ADDI	4,-1(KK)	;ADR. OF SLURX(L+1)
07300		MOVEI	SY,ALF+1
07400	SLR83:	MOVE	R,(KK)	;R=SLURX(K)-RZ
07500		FSBR	R,RZ
07600		MOVE	RX,(SY)		;RXX=SLURY(K)-RW
07700		FSBR	RX,RW
07800		MOVN	2,RA	;SLURX(K)=RB*R-RA*RXX+RZ
07900		FMPR	2,RX
08000		FADR	2,RZ
08100		MOVE	3,R
08200		FMPR	3,RB
08300		FADR 	3,2
08400		MOVEM	3,(KK)
08500		MOVE	2,RA		;83	SLURY(K)=RB*RXX+RA*R+RW
08600		FMPR	2,R
08700		FADR	2,RW
08800		MOVE	3,RX
08900		FMPR	3,RB
09000		FADR	3,2
09100		MOVEM	3,(SY)
09200		AOJ	SY,
09300		CAIGE	KK,(4)
09400		AOJA	KK,SLR83
09500	SLR87:	JRA	16,(16)
09600	A:	0
09700	B:	0
09800	L:	0
09900	
10000	RNOTE:	0	;	SUBROUTINE RNOTE(X)
10100		MOVE	2,@(16)	;COMMON /PTR/PWDS(250),ITEM,L,I,IX/XRN/RN(4000)
10200		JSA	16,AMOD	;X=RN(IFIX(PWDS(IFIX(AMOD(X,1000.))))+2)
10300		JUMP	2
10400		JUMP	[=1000.0]
10500		MOVE	2,0
10600		FIXX(2)
10700		MOVEI	3,PTR
10800		ADDI	3,(2)		;END
10900		MOVE	3,-1(3)
11000		FIXX(3)
11100		MOVEI	2,XRN
11200		ADDI	2,(3)
11300		MOVE	3,-1(2)
11400		MOVEM	3,@(16)
11500		JSA	16,1(16)
11600	
11700	DRWNT:	0   	;	SUBROUTINE DRWNT(RMINI)
11800		MOVE	5,.COMM.+2	;COMMON /STF/RSTFAC(-3/4),RSTJ2
11900		MOVEM	5,A
12000		SETZM	.COMM.+=29	;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)	
12100		MOVE	7,.COMM.+=26;EQUIVALENCE (JE,JQ(3)),(RJD,RJQ(2)),(R6,RJQ(4)),
12200		MOVEM	7,B
12300		MOVE	6,.COMM.+7 ;1(JG,JQ(5)),(R7,RJQ(5)),(RJE,RJQ(3)),(RJZ,RJQ(20))
12400		MOVEM	6,L
12500	;;	MOVE	10,.COMM.+=8 ;1 ,(JI,JQ(7)),(R9,RJQ(7)),(JH,JQ(6))
12600	;;	MOVEM	10,SLOOP
12700		MOVE	2,@(16)		;RJX=CENTR
12800		FMPR	2,[=0.5]	;JH=0  J8
12900	;  JH=0 SO IT WILL FILL. (P8 IN 'CLEFS')
13000		FDVR	2,STF+=8	;RA=R6
13100		MOVEM	2,.COMM.+7		;R6=.5*RMINI/RSTJ2
13200		MOVEM	2,.COMM.+=8		;R7=R6
13300		MOVE	2,.COMM.+=23	;RJD=RJZ-3
13400		FSBR	2,[=3.0]
13500		MOVEM	2,.COMM.+5
13600	;  ADJUSTS POSITION FOR MINI ACCIDENTALS (..??!!)
13700	;;	MOVE	11,.COMM.+=30
13800	;;	MOVEM	11,RNOTE
13900		SETZM	.COMM.+=30		;JI=0
14000		JSA	16,CLEFS	;CALL CLEFS
14100		MOVE	11,.COMM.+=10
14200		FIXX(11)
14300		MOVEM	11,.COMM.+=30	;JI=R9  (I SAVED JI IN 11)
14400	;  ↑↑↑↑↑↑ NEEDED??
14500	;  FOR WHITE NOTES AND ACCIS ON PLOTTER.
14600		MOVE	5,A
14700		MOVEM	5,.COMM.+2		;CENTR=RJX
14800		MOVE	6,L
14900		MOVEM	6,.COMM.+7		;R6=RA
15000		MOVE	7,.COMM.+=28
15100		TLC	7,232000
15200		FADR	7,7
15300		MOVEM	7,.COMM.+=8	;R7=JG
15400		MOVE	10,.COMM.+6
15500		FIXX(10)
15600		MOVEM	10,.COMM.+=26	;JE=RJE	
15700		JRA	16,1(16)	;END	(ALIGNMENT ABOVE IS OFF!)
15800	
15900	RDRAW:	0  ;	SUBROUTINE RDRAW(I,S,XY,X,R3,CENTR,RMINI)
16000		MOVEI	2,@2(16) ;C   TO X,Y INTO ONE WORD
16100		ADD	2,@(16)		;DIMENSION XY(1)
16200		MOVE	3,@1(16)	;DO 2 K=I,IFIX(S)
16300		FIXX(3)
16400		MOVEI	10,@2(16)
16500		ADDI	10,(3)
16600		MOVEM	10,DRWNT	;SAVE IT FOR NOW
16700	RD2:	MOVEI	4,2		; L=2
16800		MOVE	5,-1(2)		; Y=XY(K)
16900		CAMGE	5,[=1000.0]	;IF(Y.LT.1000.)GO TO 3
17000		JRST	RD3
17100		MOVEI	4,3		;L=3
17200		FSBR	5,[=1000.0]	;Y=Y-1000.
17300	;   >1000 = INVIS. LINE
17400	RD3:	MOVE	6,5	;3	M=Y
17500		MOVEM	4,L
17600		FIXX(6)		; M
17700		MOVE	7,6	;Y=(Y-M)*1000.
17800		TLC	7,232000
17900		FADR	7,7	; FLOATS
18000		FSBR	5,7
18100		FMPR	5,[=1000.0]	; Y
18200		CAMG	5,[=100.0]	;IF(Y.GT.100.)Y=100-Y
18300		JRST 	RD4
18400		FSBR	5,[=100.0]
18500		MOVNS	5
18600	RD4:	FMPR	5,@3(16)
18700	;   Y NUMBERS .GT.100 ARE NEG.
18800		FADR	5,@5(16)	;B=Y*X+CENTR
18900		CAIG	6,=60		;IF(M.GT.60)M=100-M
19000		JRST	RD5
19100		SUBI	6,=100
19200		MOVNS	6
19300	RD5:	TLC	6,232000     ;	A=M*RMINI+R3
19400		FADR	6,6
19500		FMPR	6,@6(16)
19600		FADR	6,@4(16)
19700		MOVEM	6,A
19800		MOVEM	5,B
19900		MOVEM	2,RNOTE		;SAVE IT FOR A SECOND
20000		JSA	16,LINES	;2	CALL LINES(A,B,L)
20100		JUMP	A
20200		JUMP	B
20300		JUMP	L
20400		MOVE	2,RNOTE
20500		CAMGE	2,DRWNT
20600		AOJA	2,RD2
20700		JRA	16,7(16)
20800	
20900	CIRCLE:	0		;	RA=5.96*RSJT2*R5
21000		MOVE	RA,.COMM.+6
21100		FMPR	RA,[=5.96]
21200		FMPR	RA,STF+=8
21300		MOVE	RB,.COMM.+=29	;J8=J8*RDIS
21400		TLC	RB,232000	;FLOAT
21500		FADR	RB,RB
21600		FMPR	RB,PLTR+2
21700		MOVE	RX,.COMM.+=28	;IF(J7.LE.J6)J7=J7+360
21800		CAMLE	RX,.COMM.+=27	;RX IS J7
21900		JRST	C2
22000		ADDI	RX,=360
22100	C2:	MOVEI	RZ,6	;	KQ=6
22200		MOVE	2,PLTR		;IF(PLT)KQ=1
22300		SKIPGE	2
22400		MOVEI	RZ,1		
22500		MOVEM	RZ,DRWNT	; DRWNT IS KQ
22600	C10:	MOVE	KK,.COMM.+=27	;10	DO 3 K=J6,J7,KQ
22700		MOVEI	LL,3		;L=3
22800		MOVEM	LL,L
22900	C3:	MOVE	R,KK		;R=K
23000		TLC	R,232000
23100		FADR 	R,R
23200		MOVEM	R,A  ;CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
23300		JSA	16,SIND
23400		JUMP	A
23500		FMPR	0,RA
23600		FADR	0,.COMM.+4
23700		MOVEM	0,B
23800		JSA	16,COSD
23900		JUMP	A
24000		FMPR	0,RA
24100		FADR	0,.COMM.+2
24200		MOVEM	0,A
24300		JSA	16,LINES
24400		JUMP	B
24500		JUMP	A
24600		JUMP	L
24700		MOVEI	LL,2	;3	L=2
24800		MOVEM	LL,L
24900		ADD	KK,DRWNT
25000		CAIG	KK,(RX)
25100		JRST	C3 
25200		FSBR	RB,[1.0]	;J8=J8-1
25300		JUMPL	RB,SLR87	;IF(J8)RETURN
25400		MOVE	2,[1.0]		;RA=RA+1/RDIS
25500		FDVR	2,PLTR+2
25600		FADR	RA,2
25700		JRST 	C10		;GO TO 10
25800	;JA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
25900				;RETURN
25950	
26000	;;	SUBROUTINE PSRT(P)
26100	;; SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
26200	;;	IMPLICIT INTEGER(S-Z)
26300	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
26400	;;	DIMENSION  P(250) **** AN ARGUMENT, INSTEAD.
26500	MM←1↔NN←2↔J←3↔LL←4↔ AA←6↔Y←7↔V←10 ↔LX←12↔RN←13↔K←14
26600	PSRT:	0	;	DO 4 K=1,ITEM
26700		MOVEI	K,@(16)		; ADR OF P
26800		MOVEI	MM,PTR		;L=PWDS(K)
26900		MOVE	NN,PTR+=250	; ITEM
27000		ADDI	NN,-1(MM)		; LAST ADR. OF PWDS
27100	PL4:	MOVE	LX,(MM)
27200		FIXX(LX)	
27300	;;;	MOVE	LL,-1(MM)	;LL=PWDS(K-1)
27400	;;;	FIXX(LL)
27500	;;;	MOVE	LM,1(MM)	;LM=PWDS(K+1)
27600	;;;	FIXX(LM)
27700		MOVEI	RN,XRN		;A=RN(L+3)
27800		ADDI	RN,(LX)
27900		MOVE	AA,2(RN)		;(L+3)
28000	 	MOVE	J,1(RN)		;P(K)=A+1000*RN(L+2)
28100		FMPR	J,[=1000.0]
28200		FADR	J,AA
28210		MOVE	V,(RN)	; IF(RN(L+1).NE.16)GO TO 40
28220		CAME	V,[=8.0]	;IF(RN(L+1).EQ.8)P(X)=P(X)-16
28230		JRST	PLA
28240		FSBR	J,[=16.0]
28250		MOVE	AA,[=1000.0]
28300	PLA:	MOVEM	J,(K)
28500		CAME	V,[16.0]
28600		JRST	PL40
28700		MOVE	Y,-1(MM)	;Y=PWDS(K-1)
28800		FIXX(Y)
29100		MOVEI	AA,XRN	; IF(RN(Y+1).EQ.16)GO TO 41
29200		ADDI	AA,(Y)
29300		MOVE	RN,(AA)
29400		CAMN	RN,[=16.0]
29500		JRST 	PL41
29510		MOVE	V,1(MM)		;V=PWDS(K+1)
29520		FIXX(V)
29600		MOVEI	AA,XRN	; IF(RN(V+1).EQ.16)GO TO 41
29700		ADDI	AA,(V)
29800		MOVE	RN,(AA)
29900		CAMN	RN,[=16.0]
30000		JRST	PL41
30100		JRST	PLS		;GO TO 4
30300	PL40:	JUMPGE	AA,PLS 	;40	IF(A.GE.0)GO TO 4
30400	PL41:	MOVN	AA,[=10000.0]	;41	P(K)=-10000
30500		MOVEM	AA,(K)
30600	PLS:	CAIL	MM,(NN)	;4	CONTINUE
30700		JRST	PLX
30800		AOJ	MM,
30900		AOJA	K,PL4
31100	;  PLOTS ALL NEG. POSITIONS FIRST.
31200	PLX:	MOVE	AA,PTR+=252	;IX=I
31300		MOVEM	AA,PTR+=253
31400		CAIL	AA,=1500		;IF(I.LT.1500)I=1500
31500		JRST 	PLY
31600		MOVEI	AA,=1500
31700		MOVEM	AA,PTR+=252
31800	PLY:	MOVEI	Y,(AA)		;	Y=I
31900		ADD	AA,PTR+=253	;I=I+IX-1
32000		SUBI	AA,1
32050		MOVEM	AA,PTR+=252
32100		MOVEM	Y,PTR+=253	;IX=Y
32200	;  IX IS M IN MAIN PROG.
32300	;  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
32400	PL2:	MOVE	AA,@(16)		;2	A=P(1)
32500		MOVEI	LX,1		;L=1
32600		MOVEI	J,1
32700		MOVEI	K,@(16)		;DO 1 K=1,ITEM
32800		MOVE	NN,PTR+=250
32900		ADDI	NN,(K)	;P(ITEM)
33000	PL1:	CAMG	AA,(K)		;IF(A.LE.P(K))GO TO 1
33100		JRST	PLZ
33200		MOVE	AA,(K)		;A=P(K)
33300		MOVE	LX,J		;L=K
33400	PLZ:	CAIL	K,-1(NN)	;1	CONTINUE
33500		JRST	PLW
33600		AOJ	K,
33700		AOJA	J,PL1
33900	PLW:	CAMN	AA,[=10000.0]	;	IF(A.EQ.10000.)RETURN
34000		JRA	16,1(16)
34100	;  ALL ITEMS HAVE NOW BEEN SHUFFLED
34200		MOVEI	V,PTR		;V=PWDS(L)
34300		ADDI	V,(LX)
34400		MOVE	V,-1(V)
34500		FIXX(V)
34600		MOVE	AA,[=10000.0]	;P(L)=10000
34700		MOVEI	J,@(16)
34800		ADDI	J,(LX)
34900		MOVEM	AA,-1(J)
35000		MOVEI	LX,XRN		;L=RN(V)+2+Y
35100		ADDI	LX,(V)
35200		MOVE	LX,-1(LX)
35300		FIXX(LX)
35400		ADDI	LX,2
35500		ADDI	LX,(Y)
35550		SUBI	V,(Y)		;V=V-Y
35800	;;	CALL LOOP(0,L,1,Y,V,RN)
35900		MOVEI	K,XRN		;DO 3 K=Y,L
36000		ADDI	K,(Y)
36100		MOVEI	NN,XRN
36200		ADDI	NN,(LX)
36300	PL3:	MOVEI	AA,(K)
36400		ADDI	AA,(V)		;3	RN(K)=RN(K+V)
36500		MOVE	AA,-1(AA)
36600		MOVEM	AA,-1(K)
36700		CAIGE	K,(NN)
36800		AOJA	K,PL3
36900	;; REPLACED SUBROUTINE LOOP
37000		MOVEI	Y,(LX)		;Y=L+1
37100		ADDI	Y,1
37200		JRST	PL2		;GO TO 2
37300		END